home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / midiin1a / midiecho.bas next >
BASIC Source File  |  1999-10-21  |  7KB  |  133 lines
  1. Attribute VB_Name = "Module1"
  2. 'All declarations, type definitions and constants
  3. 'are from WIN32API.txt coming with VB 5.0 Proffessional
  4.  
  5. 'But, the callback function created by myself,
  6. 'after wasting hours on the documents related with
  7. 'C++ Windows midi programming.
  8. 'The program is not running from VB
  9. 'on my computer. So I had to make a shortcut
  10. 'to it's EXE, and everytime compiled it to the
  11. 'same exe file and run it from desktop.
  12. 'I don't know why, but I advise you to do the same.
  13.  
  14. 'Function declarations for midi out
  15. Declare Function midiOutGetNumDevs Lib "winmm" () As Long
  16. Declare Function midiOutGetDevCaps Lib "winmm.dll" Alias "midiOutGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As MIDIOUTCAPS, ByVal uSize As Long) As Long
  17. Declare Function midiOutOpen Lib "winmm.dll" (lphMidiOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
  18. Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
  19. Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
  20. Declare Function midiOutReset Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
  21.  
  22. 'Function declarations for midi in
  23. Declare Function midiInGetNumDevs Lib "winmm.dll" () As Long
  24. Declare Function midiInGetDevCaps Lib "winmm.dll" Alias "midiInGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As MIDIINCAPS, ByVal uSize As Long) As Long
  25. Declare Function midiInOpen Lib "winmm.dll" (lphMidiIn As Long, ByVal uDeviceID As Long, ByVal dwCallback As Any, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
  26. Declare Function midiInClose Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
  27. Declare Function midiInStart Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
  28. Declare Function midiInStop Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
  29. Declare Function midiInReset Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
  30.  
  31. Public Const MAXPNAMELEN = 32  '  max product name length (including NULL)
  32.  
  33. 'Type declaration for getting the device capabilities.
  34. 'Use with midiInGetDevCaps, midiOutGetdevCaps
  35. Type MIDIINCAPS
  36.         wMid As Integer
  37.         wPid As Integer
  38.         vDriverVersion As Long
  39.         szPname As String * MAXPNAMELEN
  40. End Type
  41. Type MIDIOUTCAPS
  42.         wMid As Integer
  43.         wPid As Integer
  44.         vDriverVersion As Long
  45.         szPname As String * MAXPNAMELEN
  46.         wTechnology As Integer
  47.         wVoices As Integer
  48.         wNotes As Integer
  49.         wChannelMask As Integer
  50.         dwSupport As Long
  51. End Type
  52.  
  53. Public oxMIC As MIDIINCAPS
  54. Public oxMOC As MIDIOUTCAPS
  55. Public tmp As Long, tmp1 As Long, tmp2 As Long
  56.  
  57. 'These are the return values for the second argument
  58. 'of our callback function.
  59. Public Const MM_MIM_OPEN = &H3C1  '  Midi in device opened by MidiInOpen
  60. Public Const MM_MIM_CLOSE = &H3C2  '  Midi in device closed by MidiInOpen
  61. Public Const MM_MIM_DATA = &H3C3  '  A non sys-ex midi msg (Note on, note off, pitch ch., bank ch. volume ch. etc..)
  62. Public Const MM_MIM_LONGDATA = &H3C4  'Sys-ex data
  63. Public Const MM_MIM_ERROR = &H3C5  'An error occured inputting non sys-ex data
  64. Public Const MM_MIM_LONGERROR = &H3C6  'An error occured inputting sys-ex data
  65. Public Const MIDIERR_BASE = 64
  66. 'These are the callback types.
  67. 'We are using the CALLBACK_FUNCTION constant
  68. 'Windows calls our callback function each time
  69. 'the opened midi in port inputs data
  70. Public Const CALLBACK_TYPEMASK = &H70000      '  callback type mask
  71. Public Const CALLBACK_NULL = &H0        '  no callback
  72. Public Const CALLBACK_WINDOW = &H10000      '  dwCallback is a HWND
  73. Public Const CALLBACK_TASK = &H20000      '  dwCallback is a HTASK
  74. Public Const CALLBACK_FUNCTION = &H30000      '  dwCallback is a FARPROC
  75.  
  76. ' Check these, if a function has returned an error:
  77. ' General error return values
  78. Public Const MMSYSERR_BASE = 0
  79. Public Const MMSYSERR_NOERROR = 0  '  no error
  80. Public Const MMSYSERR_ERROR = (MMSYSERR_BASE + 1)  '  unspecified error
  81. Public Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2)  '  device ID out of range
  82. Public Const MMSYSERR_NOTENABLED = (MMSYSERR_BASE + 3)  '  driver failed enable
  83. Public Const MMSYSERR_ALLOCATED = (MMSYSERR_BASE + 4)  '  device already allocated
  84. Public Const MMSYSERR_INVALHANDLE = (MMSYSERR_BASE + 5)  '  device handle is invalid
  85. Public Const MMSYSERR_NODRIVER = (MMSYSERR_BASE + 6)  '  no device driver present
  86. Public Const MMSYSERR_NOMEM = (MMSYSERR_BASE + 7)  '  memory allocation error
  87. Public Const MMSYSERR_NOTSUPPORTED = (MMSYSERR_BASE + 8)  '  function isn't supported
  88. Public Const MMSYSERR_BADERRNUM = (MMSYSERR_BASE + 9)  '  error value out of range
  89. Public Const MMSYSERR_INVALFLAG = (MMSYSERR_BASE + 10) '  invalid flag passed
  90. Public Const MMSYSERR_INVALPARAM = (MMSYSERR_BASE + 11) '  invalid parameter passed
  91. Public Const MMSYSERR_HANDLEBUSY = (MMSYSERR_BASE + 12) '  handle being used simultaneously on another thread (eg callback)
  92. Public Const MMSYSERR_INVALIDALIAS = (MMSYSERR_BASE + 13) '  "Specified alias not found in WIN.INI
  93. Public Const MMSYSERR_LASTERROR = (MMSYSERR_BASE + 13) '  last error in range
  94.  
  95.  
  96. 'This is the callback function which windows calls during the recording.
  97. 'You SHOULD declare the arguments as I did.
  98. 'ByVal is a must, or your app or Visual Basic will crash with an
  99. ''PERFORMED AN ILLEGAL OPERATION' message. No turn back. No error handling.
  100.  
  101. 'ARGUMENTS: (Windows calls our function with these arguments)
  102. 'MidiInHandle is the same handle for the opened device
  103. 'Message is the type of the data (MM_MIM_DATA etc.)
  104. 'Instance is the argument that you passed to the dll with MidiInOpen's dwInstance arg.
  105. '     This will also pass to the callback function each time.
  106. 'dw1 is the event data in the same format of MidiOutShortMsg's data format.
  107. 'dw2 is the time value of the event in milliseconds. It starts from 0 when you called MidiInStart.
  108.  
  109. 'The name of the function and the names of the arguments are up to you.
  110.  
  111. Public Function Memorize_Event(ByVal MidiInHandle As Long, ByVal Message As Long, _
  112.             ByVal Instance As Long, ByVal dw1 As Long, ByVal dw2 As Long) As Long
  113. 'This is useful if there is an error which VB can handle.
  114. 'The error will be run over.
  115. On Error Resume Next
  116. 'Now, play the note from (or send the same event msg to)
  117. 'the internal synth (MidiOut) hMidiOut:tmp2
  118. '(If it is a real event msg)
  119. 'First Show it:
  120. If dw1 > 255 Then Form1.Text1.Text = Right("00000000" + Hex(dw1), 8)
  121. 'If it is an event, echo it to midi out device
  122. If Message = MM_MIM_DATA Then
  123.    tmp = midiOutShortMsg(tmp2, dw1)
  124. End If
  125. 'Now, this program only echoes the midi messages.
  126. 'You can do everything with the values. For example,
  127. '(All of this is for that) you can record the time,
  128. 'and the events, so this is a complete MIDI INPUT RECORDER!
  129. 'You can also convert the total data to a midi file if you know the exact format.
  130. 'After this point, IT IS ON YOU!
  131. End Function
  132.  
  133.